home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 2 / Apprentice-Release2.iso / Tools / Languages / Icon 8.1 / msm-2 / iconc.sit / tchkinv.c < prev    next >
Encoding:
C/C++ Source or Header  |  1992-09-19  |  16.0 KB  |  546 lines  |  [TEXT/MPS ]
  1. /*
  2.  * tchkinv.c - routines to determine which global names are only
  3.  *   used as immediate operand to invocation and to directly invoke
  4.  *   the corresponding operations. In addition, simple assignments to
  5.  *   names variables are recognized and it is determined whether
  6.  *   procedures return, suspend, or fail.
  7.  */
  8. #include "::h:gsupport.h"
  9. #include "trans.h"
  10. #include "tsym.h"
  11. #include "tree.h"
  12. #include "token.h"
  13. #include "globals.h"
  14. #include "tcode.h"
  15. #include "tproto.h"
  16.  
  17. /*
  18.  * prototypes for static functions.
  19.  */
  20. hidden int     chg_ret  Params((int flag));
  21. hidden novalue chksmpl  Params((struct node *n, int smpl_invk));
  22. hidden int     seq_exec Params((int exec_flg1, int exec_flg2));
  23. hidden int     spcl_inv Params((struct node *n, struct node *asgn));
  24.  
  25. static ret_flag;
  26.  
  27. /*
  28.  * chkinv - check for invocation and assignment optimizations.
  29.  */
  30. novalue chkinv()
  31.    {
  32.    struct gentry *gp;
  33.    struct pentry *proc;
  34.    int exec_flg;
  35.    int i;
  36.  
  37.    if (debug_info)
  38.        return;  /* The following analysis is not valid */
  39.  
  40.    /*
  41.     * start off assuming that global variables for procedure, etc. are
  42.     *  only used as immediate operands to invocations then mark any 
  43.     *  which are not. Any variables retaining the property are never
  44.     *  changed. Go through the code and change invocations to such
  45.     *  variables to invocations directly to the operation.
  46.     */
  47.    for (i = 0; i < GHSize; i++)
  48.       for (gp = ghash[i]; gp != NULL; gp = gp->blink) {
  49.          if (gp->flag & (F_Proc | F_Builtin | F_Record) &&
  50.             !(gp->flag & F_StrInv))
  51.                gp->flag |= F_SmplInv;
  52.          /*
  53.           * However, only optimize normal cases for main.
  54.           */
  55.          if (strcmp(gp->name, "main") == 0 && (gp->flag & F_Proc) &&
  56.             (gp->val.proc->nargs < 0 || gp->val.proc->nargs > 1))
  57.                gp->flag &= ~(uword)F_SmplInv;
  58.          /*
  59.           * Work-around to problem that a co-expression block needs
  60.           *  block for enclosing procedure: just keep procedure in
  61.           *  a variable to force outputting the block. Note, this
  62.           *  inhibits tailored calling conventions for the procedure.
  63.           */
  64.          if ((gp->flag & F_Proc) && gp->val.proc->has_coexpr)
  65.             gp->flag &= ~(uword)F_SmplInv;
  66.          }
  67.  
  68.    /*
  69.     * Analyze code in each procedure.
  70.     */
  71.    for (proc = proc_lst; proc != NULL; proc = proc->next) {
  72.       chksmpl(Tree1(proc->tree), 0);  /* initial expression */
  73.       chksmpl(Tree2(proc->tree), 0);  /* procedure body */
  74.       }
  75.  
  76.    /*
  77.     * Go through each procedure performing "naive" optimizations on
  78.     *  invocations and assignments. Also determine whether the procedure
  79.     *  returns, suspends, or fails (possibly by falling through to
  80.     *  the end).
  81.     */
  82.    for (proc = proc_lst; proc != NULL; proc = proc->next) {
  83.       ret_flag = 0;
  84.       spcl_inv(Tree1(proc->tree), NULL);
  85.       exec_flg = spcl_inv(Tree2(proc->tree), NULL);
  86.       if (exec_flg & DoesFThru)
  87.         ret_flag |= DoesFail;
  88.       proc->ret_flag = ret_flag;
  89.       }
  90.    }
  91.  
  92. /*
  93.  * smpl_invk - find any global variable uses that are not a simple
  94.  *  invocation and mark the variables.
  95.  */
  96. static novalue chksmpl(n, smpl_invk)
  97. struct node *n;
  98. int smpl_invk;
  99.    {
  100.    struct node *cases;
  101.    struct node *clause;
  102.    struct lentry *var;
  103.    int i;
  104.    int lst_arg;
  105.  
  106.    switch (n->n_type) {
  107.       case N_Alt:
  108.       case N_Apply:
  109.       case N_Limit:
  110.       case N_Slist:
  111.          chksmpl(Tree0(n), 0);
  112.          chksmpl(Tree1(n), 0);
  113.          break;
  114.  
  115.       case N_Activat:
  116.          chksmpl(Tree1(n), 0);
  117.          chksmpl(Tree2(n), 0);
  118.          break;
  119.  
  120.       case N_Augop:
  121.          chksmpl(Tree2(n), 0);
  122.          chksmpl(Tree3(n), 0);
  123.          break;
  124.  
  125.       case N_Bar:
  126.       case N_Break:
  127.       case N_Create:
  128.       case N_Field:
  129.       case N_Not:
  130.          chksmpl(Tree0(n), 0);
  131.          break;
  132.  
  133.       case N_Case:
  134.          chksmpl(Tree0(n), 0);  /* control clause */
  135.          cases = Tree1(n);
  136.          while (cases != NULL) {
  137.             if (cases->n_type == N_Ccls) {
  138.                clause = cases;
  139.                cases = NULL;
  140.                }
  141.             else {
  142.                clause = Tree1(cases);
  143.                cases = Tree0(cases);
  144.                }
  145.       
  146.             chksmpl(Tree0(clause), 0);   /* value of clause */
  147.             chksmpl(Tree1(clause), 0);   /* body of clause */
  148.             }
  149.          if (Tree2(n) != NULL)
  150.             chksmpl(Tree2(n), 0);  /* default */
  151.          break;
  152.  
  153.       case N_Cset:
  154.       case N_Int:
  155.       case N_Real:
  156.       case N_Str:
  157.       case N_Empty:
  158.       case N_Next:
  159.          break;
  160.  
  161.       case N_Id:
  162.          if (!smpl_invk) {
  163.             /*
  164.              * The variable is being used somewhere other than in a simple
  165.              *  invocation.
  166.              */
  167.             var = LSym0(n);
  168.             if (var->flag & F_Global)
  169.                var->val.global->flag &= ~F_SmplInv;
  170.             }
  171.          break;
  172.  
  173.       case N_If:
  174.          chksmpl(Tree0(n), 0);
  175.          chksmpl(Tree1(n), 0);
  176.          chksmpl(Tree2(n), 0);
  177.          break;
  178.  
  179.       case N_Invok:
  180.          lst_arg =  1 + Val0(n);
  181.          /*
  182.           * Check the thing being invoked, noting that it is in fact being
  183.           *  invoked.
  184.           */
  185.          chksmpl(Tree1(n), 1);
  186.          for (i = 2; i <= lst_arg; ++i)
  187.             chksmpl(n->n_field[i].n_ptr, 0);  /* arg i - 1 */
  188.          break;
  189.  
  190.       case N_InvOp:
  191.          lst_arg = 1 + Val0(n);
  192.          for (i = 2; i <= lst_arg; ++i)
  193.             chksmpl(n->n_field[i].n_ptr, 0);       /* arg i */
  194.          break;
  195.  
  196.       case N_Loop: {
  197.          switch ((int)Val0(Tree0(n))) {
  198.             case EVERY:
  199.             case SUSPEND:
  200.             case WHILE:
  201.             case UNTIL:
  202.                chksmpl(Tree1(n), 0);   /* control clause */
  203.                chksmpl(Tree2(n), 0);   /* do clause */
  204.                break;
  205.  
  206.             case REPEAT:
  207.                chksmpl(Tree1(n), 0);   /* clause */
  208.                break;
  209.             }
  210.          }
  211.  
  212.       case N_Ret:
  213.          if (Val0(Tree0(n)) == RETURN)
  214.             chksmpl(Tree1(n), 0);
  215.          break;
  216.  
  217.       case N_Scan:
  218.          chksmpl(Tree1(n), 0);
  219.          chksmpl(Tree2(n), 0);
  220.          break;
  221.  
  222.       case N_Sect:
  223.          chksmpl(Tree2(n), 0);
  224.          chksmpl(Tree3(n), 0);
  225.          chksmpl(Tree4(n), 0);
  226.          break;
  227.  
  228.       default:
  229.          fprintf(stderr, "compiler error: node type %d unknown\n", n->n_type);
  230.          exit(ErrorExit);
  231.       }
  232.    }
  233.  
  234. /*
  235.  * spcl_inv - look for general invocations that can be replaced by
  236.  *   special invocations. Simple assignment to a named variable is
  237.  *   is a particularly special case. Also, determine whether execution
  238.  *   might "fall through" this code and whether the code might fail.
  239.  */
  240. static int spcl_inv(n, asgn)
  241. struct node *n;
  242. struct node *asgn;  /* the result goes into this special-cased assignment */
  243.    {
  244.    struct node *cases;
  245.    struct node *clause;
  246.    struct node *invokee;
  247.    struct gentry *gvar;
  248.    struct loop {
  249.       int exec_flg;
  250.       struct node *asgn;
  251.       struct loop *prev;
  252.       } loop_info;
  253.    struct loop *loop_sav;
  254.    int exec_flg;
  255.    int i;
  256.    int lst_arg;
  257.    static struct loop *cur_loop = NULL;
  258.  
  259.    switch (n->n_type) {
  260.       case N_Activat:
  261.          if (asgn != NULL)
  262.             Val0(asgn) = AsgnDeref;  /* assume worst case */
  263.          return seq_exec(spcl_inv(Tree1(n), NULL), spcl_inv(Tree2(n), NULL));
  264.  
  265.       case N_Alt:
  266.          exec_flg = spcl_inv(Tree0(n), asgn) & DoesFThru;
  267.          return exec_flg | spcl_inv(Tree1(n), asgn);
  268.  
  269.       case N_Apply:
  270.          if (asgn != NULL)
  271.             Val0(asgn) = AsgnCopy; /* assume worst case */
  272.          return seq_exec(spcl_inv(Tree0(n), NULL), spcl_inv(Tree1(n), NULL));
  273.  
  274.       case N_Augop:
  275.          exec_flg = chg_ret(Impl1(n)->ret_flag);
  276.          if (Tree2(n)->n_type == N_Id) {
  277.             /*
  278.              * This is an augmented assignment to a named variable.
  279.              *  An optimized version of assignment can be used.
  280.              */
  281.             n->n_type = N_SmplAug;
  282.             if (Impl1(n)->use_rslt)
  283.                Val0(n) = AsgnCopy;
  284.             else
  285.                Val0(n) = AsgnDirect;
  286.             }
  287.          else {
  288.             if (asgn != NULL)
  289.                Val0(asgn) = AsgnDeref; /* this operation produces a variable */
  290.             exec_flg = seq_exec(exec_flg, spcl_inv(Tree2(n), NULL));
  291.             exec_flg = seq_exec(exec_flg, chg_ret(Impl0(n)->ret_flag));
  292.             }
  293.          return seq_exec(exec_flg, spcl_inv(Tree3(n), NULL));
  294.  
  295.       case N_Bar:
  296.          return spcl_inv(Tree0(n), asgn);
  297.  
  298.       case N_Break:
  299.          if (cur_loop == NULL) {
  300.         nfatal(n, "invalid context for break", NULL);
  301.             return 0;
  302.             }
  303.          loop_sav = cur_loop;
  304.          cur_loop = cur_loop->prev;
  305.          loop_sav->exec_flg |= spcl_inv(Tree0(n), loop_sav->asgn);
  306.          cur_loop = loop_sav;
  307.          return 0;
  308.  
  309.       case N_Create:
  310.          spcl_inv(Tree0(n), NULL);
  311.          return DoesFThru;
  312.  
  313.       case N_Case:
  314.          exec_flg = spcl_inv(Tree0(n), NULL) & DoesFail; /* control clause */
  315.          cases = Tree1(n);
  316.          while (cases != NULL) {
  317.             if (cases->n_type == N_Ccls) {
  318.                clause = cases;
  319.                cases = NULL;
  320.                }
  321.             else {
  322.                clause = Tree1(cases);
  323.                cases = Tree0(cases);
  324.                }
  325.       
  326.             spcl_inv(Tree0(clause), NULL);
  327.             exec_flg |= spcl_inv(Tree1(clause), asgn);
  328.             }
  329.          if (Tree2(n) != NULL)
  330.             exec_flg |= spcl_inv(Tree2(n), asgn);  /* default */
  331.          else
  332.             exec_flg |= DoesFail;
  333.          return exec_flg;
  334.  
  335.       case N_Cset:
  336.       case N_Int:
  337.       case N_Real:
  338.       case N_Str:
  339.       case N_Empty:
  340.          return DoesFThru;
  341.  
  342.       case N_Field:
  343.          if (asgn != NULL)
  344.             Val0(asgn) = AsgnDeref;  /* operation produces variable */
  345.          return spcl_inv(Tree0(n), NULL);
  346.  
  347.       case N_Id:
  348.          if (asgn != NULL)
  349.             Val0(asgn) = AsgnDeref;  /* variable */
  350.          return DoesFThru;
  351.  
  352.       case N_If:
  353.          spcl_inv(Tree0(n), NULL);
  354.          exec_flg = spcl_inv(Tree1(n), asgn);
  355.          if (Tree2(n)->n_type == N_Empty)
  356.             exec_flg |= DoesFail;
  357.          else
  358.             exec_flg |= spcl_inv(Tree2(n), asgn);
  359.          return exec_flg;
  360.  
  361.       case N_Invok:
  362.          lst_arg = 1 + Val0(n);
  363.          invokee = Tree1(n);
  364.          exec_flg = DoesFThru;
  365.          for (i = 2; i <= lst_arg; ++i)
  366.             exec_flg = seq_exec(exec_flg, spcl_inv(n->n_field[i].n_ptr, NULL));
  367.          if (invokee->n_type == N_Id && LSym0(invokee)->flag & F_Global) {
  368.             /*
  369.              * This is an invocation of a global variable. If we can
  370.              *  convert this to a direct invocation, determine whether
  371.              *  it is an invocation of a procedure, built-in function,
  372.              *  or record constructor; each has a difference kind of
  373.              *  direct invocation node.
  374.              */
  375.             gvar = LSym0(invokee)->val.global;
  376.             if (gvar->flag & F_SmplInv) {
  377.                switch (gvar->flag & (F_Proc | F_Builtin | F_Record)) {
  378.                   case F_Proc:
  379.                      n->n_type = N_InvProc;
  380.                      Proc1(n) = gvar->val.proc;
  381.                      return DoesFThru | DoesFail; /* assume worst case */
  382.                   case F_Builtin:
  383.                      n->n_type = N_InvOp;
  384.                      Impl1(n) = gvar->val.builtin;
  385.                      if (asgn != NULL && Impl1(n)->use_rslt)
  386.                         Val0(asgn) = AsgnCopy;
  387.                      return seq_exec(exec_flg, chg_ret(
  388.                         gvar->val.builtin->ret_flag));
  389.                   case F_Record:
  390.                      n->n_type = N_InvRec;
  391.                      Rec1(n) = gvar->val.rec;
  392.                      return seq_exec(exec_flg, DoesFThru |
  393.                         (err_conv ? DoesFail : 0));
  394.                   }
  395.                }
  396.             }
  397.          if (asgn != NULL)
  398.             Val0(asgn) = AsgnCopy; /* assume worst case */
  399.          spcl_inv(invokee, NULL);
  400.          return DoesFThru | DoesFail; /* assume worst case */
  401.  
  402.       case N_InvOp:
  403.          if (Impl1(n)->op != NULL && strcmp(Impl1(n)->op, ":=") == 0 &&
  404.             Tree2(n)->n_type == N_Id) {
  405.             /*
  406.              * This is a simple assignment to a named variable.
  407.              *  An optimized version of assignment can be used.
  408.              */
  409.             n->n_type = N_SmplAsgn;
  410.  
  411.             /* 
  412.              * For now, assume rhs of := can compute directly into a 
  413.              *  variable. This may be changed when the rhs is examined
  414.              *  in the recursive call to spcl_inv().
  415.              */
  416.             Val0(n) = AsgnDirect;
  417.             return spcl_inv(Tree3(n), n);
  418.             }
  419.          else {
  420.             /*
  421.              * No special cases.
  422.              */
  423.             lst_arg = 1 + Val0(n);
  424.             exec_flg = chg_ret(Impl1(n)->ret_flag);
  425.             for (i = 2; i <= lst_arg; ++i)
  426.                exec_flg = seq_exec(exec_flg, spcl_inv(n->n_field[i].n_ptr, 
  427.                   NULL)); /* arg i */
  428.             if (asgn != NULL && Impl1(n)->use_rslt)
  429.                Val0(asgn) = AsgnCopy;
  430.             return exec_flg;
  431.             }
  432.  
  433.       case N_Limit:
  434.          return seq_exec(spcl_inv(Tree0(n), asgn),
  435.             spcl_inv(Tree1(n), NULL)) | DoesFail;
  436.  
  437.       case N_Loop: {
  438.          loop_info.prev = cur_loop;
  439.          loop_info.exec_flg = 0;
  440.          loop_info.asgn = asgn;
  441.          cur_loop = &loop_info;
  442.          switch ((int)Val0(Tree0(n))) {
  443.             case EVERY:
  444.             case WHILE:
  445.             case UNTIL:
  446.                spcl_inv(Tree1(n), NULL);   /* control clause */
  447.                spcl_inv(Tree2(n), NULL);   /* do clause */
  448.                exec_flg = DoesFail;
  449.                break;
  450.  
  451.             case SUSPEND:
  452.                spcl_inv(Tree1(n), NULL);   /* control clause */
  453.                spcl_inv(Tree2(n), NULL);   /* do clause */
  454.                ret_flag |= DoesSusp;
  455.                exec_flg = DoesFail;
  456.                break;
  457.  
  458.             case REPEAT:
  459.                spcl_inv(Tree1(n), NULL);   /* clause */
  460.                exec_flg = 0;
  461.                break;
  462.             }
  463.          exec_flg |= cur_loop->exec_flg;
  464.          cur_loop = cur_loop->prev;
  465.          return exec_flg;
  466.          }
  467.  
  468.       case N_Next:
  469.          return 0;
  470.  
  471.       case N_Not:
  472.          exec_flg = spcl_inv(Tree0(n), NULL);
  473.          return ((exec_flg & DoesFail) ? DoesFThru : 0) |
  474.             ((exec_flg & DoesFThru) ? DoesFail: 0);
  475.  
  476.       case N_Ret:
  477.          if (Val0(Tree0(n)) == RETURN) {
  478.             exec_flg = spcl_inv(Tree1(n), NULL);
  479.             ret_flag |= DoesRet;
  480.             if (exec_flg & DoesFail)
  481.                ret_flag |= DoesFail;
  482.             }
  483.          else
  484.             ret_flag |= DoesFail;
  485.          return 0;
  486.  
  487.       case N_Scan:
  488.          if (asgn != NULL)
  489.             Val0(asgn) = AsgnCopy; /* assume worst case */
  490.          return seq_exec(spcl_inv(Tree1(n), NULL),
  491.             spcl_inv(Tree2(n), NULL));
  492.  
  493.       case N_Sect:
  494.          if (asgn != NULL && Impl0(n)->use_rslt)
  495.             Val0(asgn) = AsgnCopy;
  496.          exec_flg = spcl_inv(Tree2(n), NULL);
  497.          exec_flg = seq_exec(exec_flg, spcl_inv(Tree3(n), NULL));
  498.          exec_flg = seq_exec(exec_flg, spcl_inv(Tree4(n), NULL));
  499.          return seq_exec(exec_flg, chg_ret(Impl0(n)->ret_flag));
  500.  
  501.       case N_Slist:
  502.          exec_flg = spcl_inv(Tree0(n), NULL);
  503.          if (exec_flg & (DoesFThru | DoesFail))
  504.             exec_flg = DoesFThru;
  505.          return seq_exec(exec_flg, spcl_inv(Tree1(n), asgn));
  506.  
  507.       default:
  508.          fprintf(stderr, "compiler error: node type %d unknown\n", n->n_type);
  509.          exit(ErrorExit);
  510.          /* NOTREACHED */
  511.       }
  512.    }
  513.  
  514. /*
  515.  * seq_exec - take the execution flags for sequential pieces of code
  516.  *  and compute the flags for the combined code.
  517.  */
  518. static int seq_exec(exec_flg1, exec_flg2)
  519. int exec_flg1;
  520. int exec_flg2;
  521.    {
  522.    return (exec_flg1 & exec_flg2 & DoesFThru) |
  523.       ((exec_flg1 | exec_flg2) & DoesFail);
  524.    }
  525.  
  526. /*
  527.  * chg_ret - take a return flag and change suspend and return to
  528.  *  "fall through". If error conversion is supported, change error
  529.  *  failure to failure.
  530.  *  
  531.  */
  532. static int chg_ret(flag)
  533. int flag;
  534.    {
  535.    int flg1;
  536.  
  537.    flg1 = flag & DoesFail;
  538.    if (flag & (DoesRet | DoesSusp))
  539.       flg1 |= DoesFThru;
  540.    if (err_conv && (flag & DoesEFail))
  541.       flg1 |= DoesFail;
  542.    return flg1;
  543.    }
  544.  
  545.  
  546.